perm filename BLAISE.SAI[TEX,SYS]1 blob
sn#526715 filedate 1980-07-28 generic text, type C, neo UTF8
COMMENT ⊗ VALID 00005 PAGES
C REC PAGE DESCRIPTION
C00001 00001
C00002 00002 begin "blaise" comment A TEX preprocessor for PASCAL.
C00008 00003 Basic input/output and lookup procedures
C00014 00004 Scanning procedures
C00036 00005 The main program
C00043 ENDMK
C⊗;
begin "blaise" comment A TEX preprocessor for PASCAL.
(See the documentation on file BLAISE.DEK[up,doc].);
require "⊂⊃⊂⊃" delimiters; "used for macros"
define # = ⊂;comment⊃; "used henceforth instead of quoted comments like this"
define nextline = ⊂('15&'12)⊃ # carriage-return and line-feed in print commands;
define thru = ⊂step 1 until⊃ # abbreviation for for clauses;
define DEBUGONLY = ⊂comment⊃ # changed to ⊂⊃ when debugging;
define saf = ⊂safe⊃ # used when an array is believed to require no bounds checks;
DEBUGONLY redefine saf = ⊂⊃ # when debugging, belief turns to disbelief;
DEBUGONLY external procedure bail # the SAIL debugger in case of need;
require 500 system_pdl # this program is highly recursive;
require 500 string_pdl # and gets in trouble without big stacks;
require 25000 string_space;
label final_end # go here when you want to quit;
integer ichan,ochan,brchar,eof,lineno,pageno # standard variables of input system;
string inbuf,curbuf # the input buffers;
string filename,inputfile,outputfile # variables relating to file names;
string saf array fn[0:2] # components of file name;
procedure scanfilename # parses filename, puts parts in the fn array;
begin integer t # (0,1,2) for (name,ext,ppn);
string s # temporary storage;
integer c # current character of string;
s←filename; t←0; fn[0]←fn[1]←fn[2]←"";
while (c←lop(s)) do
begin if c="." then t←1 else if c="[" then t←2;
fn[t]←fn[t]&c;
end;
end;
procedure initio # initialize input and output;
begin while true do
begin print("Input file: "); filename←inchwl; scanfilename;
if fn[1]=0 then fn[1]←".PAS";
inputfile←fn[0]&fn[1]&fn[2];
open(ichan←getchan,"DSK",0,19,0,200,brchar,eof);
lookup(ichan,inputfile,eof);
if not eof then done;
print("Lookup failed on file ",inputfile,"!",nextline);
release(ichan);
end;
while true do
begin fn[1]←".TEX";
outputfile←fn[0]&fn[1]&fn[2];
print("Output file (default = ",outputfile,"): ");
filename←inchwl;
if filename then
begin scanfilename;
outputfile←fn[0]&fn[1]&fn[2];
end;
open(ochan←getchan,"DSK",0,0,19,0,0,eof);
enter(ochan,outputfile,eof);
if not eof then done;
print("Can't write on file ",outputfile,"!",nextline);
release(ochan);
filename←inputfile; scanfilename;
end;
setprint("errors.tmp","B") # output goes to file as well as to user terminal;
setbreak(1,'14,null,"INA") # input(ichan,1) will read up to and including <FF>;
setbreak(2,'12&'14,'15,"INS") # input(ichan,2) will read up to and including
<LF> or <FF>, discarding <LF>, <FF>, and <CR>;
inbuf←""; pageno←0; brchar←'14;
end;
procedure error(string s) # prints a message to report an anomaly;
begin integer l; l←length(inbuf)-length(curbuf);
print(nextline,"! ",s,".",
nextline,"p.",pageno,",l.",lineno,": ",inbuf[1 to l],""&'12,curbuf);
end;
procedure overflow(string s) # prints error message and aborts;
begin print(nextline,"Capacity exceeded (",s,"), some input is lost.");
go to final_end;
end;
comment Basic input/output and lookup procedures;
boolean identins # if identifier isn't found, insert it;
comment Identifiers are stored in a conventional binary search tree, whose
nodes contain the following fields:
idname[k], the identifier stored at node k (a string) followed by "}",
left[k], left son of node k,
right[k], right son of node k,
eq[k], the defined equivalent of node k.
The value of eq[k] tells what kind of identifier this is. For example, the
reserved words "begin" and "loop" both have the eq value "t_begin";
define strsize=150 # number of different identifiers allowed;
string saf array idname[1:strsize] # identifier names;
integer saf array left,right,eq[0:strsize] # sons and equivalents;
integer nstrs # number of nodes in the tree;
integer procedure find(string x) # looks for the identifier x;
begin comment This procedure either finds x in the tree, or (if identins is
false) finds the node whose eq field is "ident";
integer k # current node;
integer link # pointer to new node if insertion needs to be done;
string xx # x with a right brace after it;
xx←x&"}";
k←1; link←nstrs+1; idname[link]←xx;
if k<link then while true do
begin string s,t; integer d;
if equ(xx,idname[k]) then return(k);
s←xx; t←idname[k];
while (d←lop(s)-lop(t))=0 do;
comment No string will be a prefix of another since they end with "}";
if d<0 then
if left[k] then k←left[k]
else begin left[k]←link; done;
end
else if right[k] then k←right[k]
else begin right[k]←link; done;
end;
end;
if identins then
begin if link≥strsize then overflow("strsize");
nstrs←link; left[nstrs]←right[nstrs]←0;
end;
return(link);
end;
define space=1,letter=2,digit=3,doublequote=4,singlequote=5,lpren=6,dot=7,
lbr=8,ident=9,const=10,otherchar=11,star=12,t_up=13,doubledots=14,comma=15,
colon=16,t_comment=17,semi=18,t_close=19,t_string=20,t_program=21,t_var=22,
t_procedure=23,t_begin=24,t_packed=25,t_to=26,t_div=27,t_nil=28,t_record=29,
t_array=30,t_of=31,t_case=32,t_repeat=33,t_until=34,t_then=35,t_if=36,
t_exit=37,t_end=38,underline=39,t_else=40,t_eof=41,t_file=42,t_for=43,t_label=44
# arbitrary codes used in the scanner;
preload_with t_eof, [7] otherchar,
otherchar, [3] space, t_eof, space, [2] otherchar,
[8] otherchar,
underline, [7] otherchar,
space, otherchar, doublequote, [4] otherchar, singlequote,
lpren, t_close, star, otherchar, comma, otherchar, dot, otherchar,
[8] digit,
[2] digit, colon, semi, [4] otherchar,
t_up, [7] letter,
[16] letter,
[3] letter, lbr, otherchar, t_close, t_up, otherchar,
singlequote, [7] letter,
[16] letter,
[3] letter, [5] otherchar;
saf integer array chartype[0:'177] # types for SUAI ascii;
string curstr # the current translated string;
define cr='15, c5='14, c0='12, c2='13 # characters interpreted by the
putout procedure;
integer state # if nonzero, this is substituted for the 0 or 2 in \0 or \2;
integer lastout # the last character that was putout (prevents consec cr's);
procedure putout # sends curstr to output, slightly interpreting it;
begin integer c;
while true do
begin c←lop(curstr);
if c=0 then done;
if c="\" and state and (curstr="0" or curstr="2") then
begin out(ochan,"\"); out(ochan,state); c←lop(curstr); state←0;
end
else case c of begin
[cr] if lastout≠cr then begin out(ochan,nextline); lastout←cr end;
[c0] state←"0";
[c2] if state≠"5" then state←"2";
[c5] state←"5";
else begin out(ochan,c); lastout←c
end
end;
end;
end;
comment Scanning procedures;
integer curtype # type of the token currently being scanned;
string cur5 # either null or c5 (if blank line found by getnext);
string curstr5 # cur5 & curstr;
integer fillcount # increases by 1 when a new line or page is read;
boolean activity # getnext has been called;
procedure fillinbuf # gets the next line of input;
begin if brchar='14 then
begin pageno←pageno+1; lineno←1; print(" ",pageno);
fillcount←fillcount+1;
end
else lineno←lineno+1;
inbuf←input(ichan,2);
if eof and inbuf=0 then inbuf←'14 # the scanner treats '14 as end-of-file;
if pageno=1 and lineno=1 and equ(inbuf[1 to 9],"COMMENT ⊗") then
begin comment skip TVedit directory page;
while brchar≠'14 and not eof do inbuf←input(ichan,1);
inbuf←"";
end;
curbuf←inbuf;
fillcount←fillcount+1;
end;
procedure getnext # gets the next input token;
begin comment The other procedures for scanning call this one whenever
the current character has been digested and it is time to read a new one.
This procedure is the lexical scanner. It processes identifiers, constants,
comments, "..", and ordinary single characters, setting curtype to the
appropriate code value. It also sets curstr equal to the translation of
the scanned token. Spaces in the input are ignored (except in strings and
comments). Blank lines in the input cause curstr5 to contain a c5 character;
integer c; label restart;
fillcount←-1; activity←true;
restart: while curbuf=0 do fillinbuf;
c←lop(curbuf); curtype←chartype[c];
case curtype of begin
[space] go to restart;
[letter] begin curstr←c; while true do
begin c←chartype[curbuf];
if c=letter or c=digit then curstr←curstr&lop(curbuf)
else if c=underline then
begin c←lop(curbuf); curstr←curstr&"\_";
end
else done;
end;
curtype←eq[find(curstr)]; if curtype=ident then curstr←"\\{"&curstr&"}" end;
[digit] begin curstr←c; curtype←const; while true do
begin c←chartype[curbuf];
if c=digit then curstr←curstr&lop(curbuf)
else if c=letter then curstr←curstr&"\mathopen{\hbox{"&lop(curbuf)
&"}}"
else done;
end end;
[doublequote] begin curstr←"\.{"&c; curtype←const; # hexadecimal constant;
while true do
begin c←chartype[curbuf];
if c=digit or c=letter then curstr←curstr&lop(curbuf)
else done;
end;
curstr←curstr&"}"; end;
[singlequote] begin curstr←c; curtype←t_string; while true do
begin c←lop(curbuf);
if c='40 then curstr←curstr&"\ "
else if c then
begin curstr←curstr&c;
if c="'" then done;
end
else begin error("String constant didn't end on the line"); done;
end;
end end;
[lpren] if curbuf≠"*" then curstr←c else
begin curstr←"$\{\;$"; curtype←t_comment; c←lop(curbuf);
while true do
begin c←lop(curbuf);
if c="*" and curbuf=")" then
begin c←lop(curbuf); curstr←curstr&("$\;\}$"&cr&c2);
done;
end
else if c=0 then
begin fillinbuf; if inbuf then fillcount←fillcount-1;
curstr←curstr&cr;
end
else if c='14 then
begin error("End of file in middle of comment");
curbuf←"*)"&'14;
end
else curstr←curstr&c;
end;
end;
[dot] if curbuf="." then
begin curtype←doubledots; curstr←"\mathrel{\!.\,.\!}"; c←lop(curbuf);
end
else curstr←c;
else curstr←c
end;
if fillcount>0 then cur5←c5 else cur5←""; curstr5←cur5&curstr;
end;
comment The recursive procedures below follow the syntax in BLAISE.SYN
fairly closely;
forward recursive string procedure p_fragment;
forward recursive string procedure p_genexp;
forward recursive string procedure p_outertoken;
forward recursive string procedure p_innertoken;
forward recursive string procedure p_token;
forward recursive string procedure p_speciallist;
forward recursive string procedure p_comments;
forward recursive string procedure p_variant;
forward recursive string procedure p_compoundstatement;
forward recursive string procedure p_statement1;
forward recursive string procedure p_noncompoundstatement;
forward recursive string procedure p_statement;
forward recursive string procedure p_case;
recursive string procedure p_fragment;
begin string str;
case curtype of begin
[t_program] begin str←cur5&"\3\2\&{"&curstr&"} "; getnext;
str←str&p_genexp&"\1" end;
[t_label] begin str←cur5&"\3\2\1\&{"&curstr&"} "; getnext;
while true do
begin case curtype of begin
[ident][const] begin str←str&cur5&"\0"&curstr; getnext end;
[comma] begin str←str&curstr5&"\45\ "; getnext end;
[t_comment] begin str←str&"\40\ "&curstr5; getnext end;
else done
end
end end;
[t_var] begin str←cur5&"\3\2\1\&{"&curstr&"} "; getnext;
str←str&p_genexp end;
[t_procedure] begin str←cur5&"\3\2\1\1\&{"&curstr&"} "; getnext;
str←str&p_genexp end;
[t_begin] begin str←cur5&"\3\2"; cur5←""; curstr5←curstr;
str←str&p_compoundstatement end;
else begin str←cur5&c2; cur5←""; curstr5←curstr;
str←str&p_noncompoundstatement end
end;
return(str);
end;
recursive string procedure p_genexp;
begin string str; integer n;
n←50; str←""; while true do
begin case curtype of begin
[lpren][dot][lbr][ident][const][otherchar][star][t_up][doubledots][comma]
[colon][t_comment][t_string][t_record][t_packed][t_to][t_div][t_nil]
[t_array][t_file] str←str&p_outertoken;
else done
end;
if length(str)>n then
begin comment try to avoid long lines in output;
str←str&cr; n←n+50;
end;
end;
if str then return("$"&str&"$") else return("");
end;
recursive string procedure p_outertoken;
begin string str;
case curtype of begin
[lpren][lbr][t_array][t_file] begin if curtype=t_array then
str←"\mathop{\&{"&curstr5&" }}" else if curtype=t_file then
str←"\mathop{\&{"&curstr5&"}\!}"
else str←curstr5; getnext; while true do
begin integer n; n←50;
case curtype of begin
[lpren][dot][lbr][ident][const][otherchar][star][t_up][doubledots][comma]
[colon][t_comment][semi][t_string][t_var][t_procedure][t_record][t_packed]
[t_to][t_div][t_nil][t_array][t_file] str←str&p_innertoken;
else done
end;
if length(str)>n then
begin comment try to avoid long lines in output;
str←str&cr; n←n+50;
end;
end;
if curtype = t_close then
begin str←str&curstr5; getnext;
end
else if curtype=t_of then
begin str←str&"\mathop{\&{\ "&curstr5&" }\!}"; getnext;
end
else error("Missing a closing symbol") end;
[ident][const][otherchar][star][t_up][t_packed][t_to][t_div][t_nil] str←p_token;
[dot] begin str←curstr5; getnext; str←str&p_token end;
[doubledots] begin str←curstr5; getnext end;
[comma] begin str←curstr5&"\45"; getnext end;
[colon] begin str←"\mathrel"&curstr5; getnext end;
[t_record] begin str←cur5&"\null$\1\2\&{"&curstr&"} "; getnext;
str←str&c0&p_speciallist;
if curtype=t_end then
begin str←str&cur5&c2&"\2\&{"&curstr&"}$\null\3"; getnext;
end
else begin error("Missing end of record type"); str←str&"\3";
end end;
[t_comment] begin str←"\null$\40 "&curstr5&("$\null"&cr); getnext end;
[t_string] begin str←"\.{"&curstr5&"}"; getnext end;
else error("Bug 1 in BLAISE")
end;
return(str);
end;
recursive string procedure p_innertoken;
begin string str;
case curtype of begin
[lpren][dot][lbr][ident][const][otherchar][star][t_up][doubledots][comma][colon]
[t_comment][t_string][t_record][t_packed][t_to][t_div][t_nil]
[t_array][t_file] str←p_outertoken;
[semi] begin str←curstr5&"\42\,"; getnext end;
[t_var][t_procedure] begin str←"\mathop{\&{"&curstr5&"}}"; getnext end;
else error("Bug 2 in BLAISE")
end;
return(str);
end;
recursive string procedure p_token;
begin string str;
case curtype of begin
[ident][const][otherchar] begin str←curstr5; getnext end;
[t_packed] begin str←"\mathop{\&{"&curstr5&" }\!}"; getnext end;
[t_to] begin str←"\mathrel{\&{"&curstr5&"}}"; getnext end;
[t_up] begin str←cur5&"{\up}"; getnext end;
[star] begin str←cur5&"{\ast}"; getnext end;
[t_div] begin str←"\mathbin{\&{"&curstr5&"}}"; getnext end;
[t_nil] begin str←"\&{"&curstr5&"}"; getnext end;
else error("Missing token")
end;
return(str);
end;
recursive string procedure p_speciallist;
begin string str,str1,str2;
str←""; while true do
begin str1←cur5; cur5←""; curstr5←curstr;
str2←p_genexp;
if str2 then str←str&str1&"\2"&str2 else str←str&str1;
if curtype≠semi then done;
str←str&curstr5; getnext;
str←str&p_comments;
end;
while curtype=t_case do
begin str←str&cur5&"\2\1\&{"&curstr&"} "; getnext;
str←str&p_genexp;
if curtype=t_of then
begin str←str&" \&{"&curstr5&"}"; getnext;
end
else error("Missing `of'");
while true do
begin str←str&p_variant;
if curtype≠semi then done;
str←str&curstr5; getnext;
end;
str←str&"\3";
end;
return(str);
end;
recursive string procedure p_comments;
begin string str;
if curtype≠t_comment then return(cr);
str←("\40\"&cr)&curstr5; getnext;
while curtype=t_comment do
begin str←str&cur5&"\2"&curstr; getnext;
end;
return(str);
end;
recursive string procedure p_variant;
begin string str;
str←p_comments;
case curtype of begin
[ident][const] ;
[comma] curstr←curstr&"\45";
else return(str)
end;
str←str&cur5&(cr&"\2\1$")&curstr; getnext;
while true do
begin case curtype of begin
[ident][const] ;
[comma] curstr←curstr&"\45";
[t_comment] curstr←" $\40\ "&curstr&("$");
[colon] begin str←str&"\mathrel"&curstr5; getnext; done end;
else begin error("Improper token list in variant"); done;
end
end;
str←str&cur5&curstr; getnext;
end;
str←str&"\null$"&p_comments;
if curtype=lpren then
begin str←str&curstr5&c0; getnext;
end
else error("Missing `(' in variant");
str←str&p_speciallist;
if curtype=t_close then
begin str←str&curstr5; getnext;
end
else error("Missing `)' in variant");
str←str&p_comments;
return(str&"\3");
end;
recursive string procedure p_compoundstatement;
begin string str,str1; label recover;
str←"\&{"&curstr5&"} "; getnext;
str←str&p_statement1;
recover: while curtype=semi do
begin str←str&curstr5; getnext;
str←str&p_comments&p_statement;
end;
str←str&p_comments;
if curtype=t_end then
begin str←str&cur5&(c2&"\2\&{")&curstr&("}"&c2); getnext;
end
else begin error("Missing `;'");
str1←p_statement; if str1 then
begin str←str&str1; go to recover;
end;
error("Missing `end'");
str←str&(c2&"\2"&c2);
end;
return(str);
end;
boolean procedure labelpresent # looks ahead to see if colon and no equals is next;
begin integer c,d; label restart;
restart: while chartype[curbuf]=space do c←lop(curbuf);
if curbuf=0 then
begin fillinbuf; go to restart;
end;
if chartype[curbuf]=colon then
begin label restart;
d←lop(curbuf);
restart: while chartype[curbuf]=space do c←lop(curbuf);
if curbuf=0 then
begin fillinbuf; go to restart;
end;
if curbuf≠"=" then return(true) else curbuf←d&curbuf;
end;
return(false);
end;
recursive string procedure p_statement1;
begin string str,str1;
case curtype of begin
[t_comment] begin str←"\40\ "&curstr5; getnext; while curtype=t_comment do
begin str←str&cur5&"\2"&curstr; getnext;
end;
str←str&p_statement end;
[t_begin] str←"\1"&p_compoundstatement&"\3";
[ident][const] if labelpresent then begin str←cur5&"\2"&curstr&": "; getnext;
str←str&p_statement1 end
else str←c0&p_noncompoundstatement;
else str←c0&p_noncompoundstatement
end;
return(str);
end;
recursive string procedure p_noncompoundstatement;
begin string str; integer tif;
case curtype of begin
[t_exit] begin str←cur5&"\2\&{"&curstr; getnext;
if curtype=t_if then
begin str←str&" "&curstr5&"} "; getnext;
end
else begin error("Missing `if'"); str←str&"}";
end;
str←str&p_genexp end;
[t_if][t_for] begin tif←curtype; str←cur5&"\2\1\&{"&curstr; getnext;
str←str&"} "&p_genexp;
if curtype=t_then then
begin str←str&" \&{"&curstr5&"}"; getnext;
end
else begin error("Missing `then' or `do'"); str←str&" ";
end;
str←str&p_comments&p_statement&("\3"&c2)&p_comments;
if tif=t_if and curtype=t_else then
begin str←str&cur5&"\2\&{"&curstr; getnext;
str←str&"} "&p_statement1&c2&p_comments;
end end;
[t_repeat] begin str←cur5&"\2\1\&{"&curstr; getnext;
str←str&"} "&p_statement1;
while curtype=semi do
begin str←str&curstr5; getnext;
str←str&p_comments&p_statement;
end;
str←str&p_comments&cur5&c2&"\3\2\&{";
if curtype=t_until then
begin str←str&curstr; getnext;
end
else error("Missing `until'");
str←str&"} "&p_genexp&c2 end;
[t_case] begin str←cur5&"\2\1\&{"&curstr; getnext;
str←str&"} "&p_genexp;
if curtype = t_of then
begin str←str&" \&{"&curstr5&"}"; getnext;
end
else error("Missing `of'");
str←str&p_case;
while curtype=semi do
begin str←str&curstr5; getnext;
str←str&p_case;
end;
str←str&p_comments;
if curtype=t_end then
begin str←str&cur5&c2&"\2\&{"&curstr&("}\3"&c2); getnext;
end
else begin error("Missing `end'"); str←str&("\3\2"&c2);
end end;
else begin str←p_genexp; if str then begin if str[2 for 1]=c5 then
str←(c5&"\0$")& str[3 to ∞] else str←"\0"&str end end
end;
return(str);
end;
recursive string procedure p_statement;
begin string str;
case curtype of begin
[t_begin] begin str←str&cur5&"\2"; cur5←""; curstr5←curstr;
str←str&p_compoundstatement end;
[ident][const] if labelpresent then begin str←cur5&"\2"&curstr&": ";
getnext; str←str&p_statement1 end
else str←str&p_noncompoundstatement;
else str←str&p_noncompoundstatement
end;
return(str);
end;
recursive string procedure p_case;
begin string str;
str←p_comments;
case curtype of begin
[ident][const][t_string] begin str←str&cur5&c2&"\2\1";cur5←"";curstr5←curstr;
while true do
begin case curtype of begin
[comma] begin str←str&curstr5&"\45\ "; getnext end;
[t_comment] begin str←str&"\40\ "&curstr5; getnext end;
[colon] begin str←str&curstr5&" "; getnext; done end;
[ident][const] str←str&p_token;
[t_string] begin str←str&curstr; getnext end;
else begin error("Missing `:'"); done end
end;
end;
str←str&p_statement1&"\3" end;
else comment do nothing;
end;
return(str);
end;
comment The main program;
nstrs←0; identins←true;
eq[find("label")]←t_var;
eq[find("Label")]←t_var;
eq[find("LABEL")]←t_var;
eq[find("else")]←t_else;
eq[find("Else")]←t_else;
eq[find("ELSE")]←t_else;
eq[find("case")]←t_case;
eq[find("Case")]←t_case;
eq[find("CASE")]←t_case;
eq[find("array")]←t_array;
eq[find("Array")]←t_array;
eq[find("ARRAY")]←t_array;
eq[find("and")]←t_div;
eq[find("And")]←t_div;
eq[find("AND")]←t_div;
eq[find("begin")]←t_begin;
eq[find("Begin")]←t_begin;
eq[find("BEGIN")]←t_begin;
eq[find("div")]←t_div;
eq[find("Div")]←t_div;
eq[find("DIV")]←t_div;
eq[find("const")]←t_var;
eq[find("Const")]←t_var;
eq[find("CONST")]←t_var;
eq[find("do")]←t_then;
eq[find("Do")]←t_then;
eq[find("DO")]←t_then;
eq[find("downto")]←t_to;
eq[find("Downto")]←t_to;
eq[find("DOWNTO")]←t_to;
eq[find("function")]←t_procedure;
eq[find("Function")]←t_procedure;
eq[find("FUNCTION")]←t_procedure;
eq[find("exit")]←t_exit;
eq[find("Exit")]←t_exit;
eq[find("EXIT")]←t_exit;
eq[find("end")]←t_end;
eq[find("End")]←t_end;
eq[find("END")]←t_end;
eq[find("file")]←t_file;
eq[find("File")]←t_file;
eq[find("FILE")]←t_file;
eq[find("for")]←t_for;
eq[find("For")]←t_for;
eq[find("FOR")]←t_for;
eq[find("if")]←t_if;
eq[find("If")]←t_if;
eq[find("IF")]←t_if;
eq[find("goto")]←t_packed;
eq[find("Goto")]←t_packed;
eq[find("GOTO")]←t_packed;
eq[find("in")]←t_to;
eq[find("In")]←t_to;
eq[find("IN")]←t_to;
eq[find("initprocedure")]←t_procedure;
eq[find("Initprocedure")]←t_procedure;
eq[find("INITPROCEDURE")]←t_procedure;
eq[find("record")]←t_record;
eq[find("Record")]←t_record;
eq[find("RECORD")]←t_record;
eq[find("of")]←t_of;
eq[find("Of")]←t_of;
eq[find("OF")]←t_of;
eq[find("mod")]←t_div;
eq[find("Mod")]←t_div;
eq[find("MOD")]←t_div;
eq[find("loop")]←t_begin;
eq[find("Loop")]←t_begin;
eq[find("LOOP")]←t_begin;
eq[find("nil")]←t_nil;
eq[find("Nil")]←t_nil;
eq[find("NIL")]←t_nil;
eq[find("not")]←t_packed;
eq[find("Not")]←t_packed;
eq[find("NOT")]←t_packed;
eq[find("packed")]←t_packed;
eq[find("Packed")]←t_packed;
eq[find("PACKED")]←t_packed;
eq[find("or")]←t_div;
eq[find("Or")]←t_div;
eq[find("OR")]←t_div;
eq[find("procedure")]←t_procedure;
eq[find("Procedure")]←t_procedure;
eq[find("PROCEDURE")]←t_procedure;
eq[find("program")]←t_program;
eq[find("Program")]←t_program;
eq[find("PROGRAM")]←t_program;
eq[find("to")]←t_to;
eq[find("To")]←t_to;
eq[find("TO")]←t_to;
eq[find("segmented")]←t_packed;
eq[find("Segmented")]←t_packed;
eq[find("SEGMENTED")]←t_packed;
eq[find("repeat")]←t_repeat;
eq[find("Repeat")]←t_repeat;
eq[find("REPEAT")]←t_repeat;
eq[find("set")]←t_file;
eq[find("Set")]←t_file;
eq[find("SET")]←t_file;
eq[find("then")]←t_then;
eq[find("Then")]←t_then;
eq[find("THEN")]←t_then;
eq[find("var")]←t_var;
eq[find("Var")]←t_var;
eq[find("VAR")]←t_var;
eq[find("type")]←t_var;
eq[find("Type")]←t_var;
eq[find("TYPE")]←t_var;
eq[find("until")]←t_until;
eq[find("Until")]←t_until;
eq[find("UNTIL")]←t_until;
eq[find("while")]←t_for;
eq[find("While")]←t_for;
eq[find("WHILE")]←t_for;
eq[find("with")]←t_for;
eq[find("With")]←t_for;
eq[find("WITH")]←t_for;
eq[nstrs+1]←ident; identins←false;
comment From now on, all other identifiers will be equivalent to `ident';
initio;
print("(",inputfile);
out(ochan,
"\input basic % Delete this line if you merge BLAISE output with another .TEX file
\input algol % This file defines the necessary macros and font \:t
{\ragged1000000 \jpar10000 \setcount7\Tbb\1 % Beginning BLAISE output:
") # the above info always comes first in the output file;
lastout←cr;
getnext;
while curtype≠t_eof do
begin activity←false;
while true do
begin case curtype of begin
[dot][semi] curstr←curstr5;
[t_comment] if cur5 then curstr←c5&"\3\2"&curstr&"\1"
else curstr←"\40\ "&curstr;
else done
end;
putout; getnext;
end;
curstr←cr&p_fragment; putout;
if not activity then
begin error("Uninterpretable fragment"); getnext;
end;
end;
print(")");
out(ochan,"
\par} % end of BLAISE output
");
final_end: close(ichan); close(ochan);
end